home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / grog < prev    next >
Text File  |  2009-08-18  |  9KB  |  380 lines
  1. #! /usr/bin/env perl
  2. # grog - guess options for groff command
  3. # Inspired by doctype script in Kernighan & Pike, Unix Programming
  4. # Environment, pp 306-8.
  5.  
  6. # Source file position: <groff-source>/src/roff/grog/grog.pl
  7. # Installed position: <prefix>/bin/grog
  8.  
  9. # Copyright (C) 1993, 2006, 2009 Free Software Foundation, Inc.
  10. # Written by James Clark, maintained by Werner Lemberg.
  11. # Rewritten and put under GPL by Bernd Warken.
  12.  
  13. # This file is part of `grog', which is part of `groff'.
  14.  
  15. # `groff' is free software; you can redistribute it and/or modify it
  16. # under the terms of the GNU General Public License (GPL) as published
  17. # by the Free Software Foundation, either version 3 of the License, or
  18. # (at your option) any later version.
  19.  
  20. # `groff' is distributed in the hope that it will be useful, but
  21. # WITHOUT ANY WARRANTY; without even the implied warranty of
  22. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23. # General Public License for more details.
  24.  
  25. # You should have received a copy of the GNU General Public License
  26. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  27.  
  28. ########################################################################
  29. my $Last_Update = '5 Jan 2009';
  30. ########################################################################
  31.  
  32. require v5.6;
  33.  
  34. use warnings;
  35. use strict;
  36. use File::Spec;
  37.  
  38. my $Prog = $0;
  39. {
  40.   my ($v, $d, $f) = File::Spec->splitpath($Prog);
  41.   $Prog = $f;
  42. }
  43.  
  44. #my $Sp = "[\\s\\n]";
  45. my $Sp = qr([\s\n]);
  46.  
  47. my @Command;            # stores the final output
  48. my @Mparams;            # stores the options -m*
  49. my %Groff;
  50.  
  51. {
  52.   my @filespec = ();
  53.   my $double_minus = 0;
  54.   my $was_minus = 0;
  55.   my $had_filespec = 0;
  56.  
  57.   foreach my $arg (@ARGV) {
  58.     next unless $arg;
  59.     if ($double_minus) {
  60.       $had_filespec = 1;
  61.       if (-f $arg && -r $arg) {
  62.     push @filespec, $arg;
  63.       } else {
  64.     print STDERR "grog: $arg is not a readable file.\n";
  65.       }
  66.       next;
  67.     }
  68.  
  69.     if ($arg eq '--') {
  70.       $double_minus = 1;
  71.       push(@Command, $arg);
  72.       next;
  73.     }
  74.     if ($arg eq '-') {
  75.       unless ($was_minus) {
  76.     push @filespec, $arg;
  77.     $was_minus = 1;
  78.       }
  79.       next;
  80.     }
  81.  
  82.     &version(0) if $arg eq '-v' || '--version' =~ /^$arg/;
  83.     &help() if $arg eq '-h' || '--help' =~ /^$arg/;
  84.     print STDERR "grog: wrong option $arg.\n" if $arg =~ /^--/;
  85.  
  86.     if ($arg =~ /^-m/) {
  87.       push @Mparams, $arg;
  88.       next;
  89.     }
  90.     $Sp = '' if $arg eq '-C';
  91.  
  92.     if ($arg =~ /^-/) {
  93.       push(@Command, $arg);
  94.       next;
  95.     } else {
  96.       $had_filespec = 1;
  97.       if (-f $arg && -r $arg) {
  98.     push @filespec, $arg;
  99.       } else {
  100.     print STDERR "grog: $arg is not a readable file.\n";
  101.       }
  102.       next;
  103.     }
  104.   }
  105.   @filespec = ('-') if ! @filespec && ! $had_filespec;
  106.   exit 1 unless @filespec;
  107.   @ARGV = @filespec;
  108. }
  109.  
  110. foreach my $arg (@ARGV) {
  111.   &process($arg, 0);
  112. }
  113.  
  114. sub process {
  115.   my ($filename, $level) = @_;
  116.   local(*FILE);
  117.  
  118.   if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
  119.     print STDERR "$Prog: can't open \`$filename': $!\n";
  120.     exit 1 unless $level;
  121.     return;
  122.   }
  123.   while (<FILE>) {
  124.     chomp;
  125.     s/^[.']\s*/./;
  126.     s/^\s+|\s+$//g;
  127.     s/$/\n/;
  128.  
  129.     if (/^(.cstart)|(begin\s+chem)$/) {
  130.       $Groff{'chem'}++;
  131.       $Groff{'pic'}++;
  132.     } elsif (/^\.TS$Sp/) {
  133.       $_ = <FILE>;
  134.       if (!/^\./) {
  135.     $Groff{'tbl'}++;
  136.     $Groff{'soelim'}++ if $level;
  137.       }
  138.     } elsif (/^\.EQ$Sp/) {
  139.       $_ = <FILE>;
  140.       if (!/^\./ || /^\.[0-9]/) {
  141.     $Groff{'eqn'}++;
  142.     $Groff{'soelim'}++ if $level;
  143.       }
  144.     } elsif (/^\.GS$Sp/) {
  145.       $_ = <FILE>;
  146.       if (!/^\./) {
  147.     $Groff{'grn'}++;
  148.     $Groff{'soelim'}++ if $level;
  149.       }
  150.     } elsif (/^\.G1$Sp/) {
  151.       $_ = <FILE>;
  152.       if (!/^\./) {
  153.     $Groff{'grap'}++;
  154.     $Groff{'pic'}++;
  155.     $Groff{'soelim'}++ if $level;
  156.       }
  157. #    } elsif (/^\.PS\Sp([ 0-9.<].*)?$/) {
  158. #      if (/^\.PS\s*<\s*(\S+)/) {
  159. #    $Groff{'pic'}++;
  160. #    $Groff{'soelim'}++ if $level;
  161. #    &process($1, $level);
  162. #      } else {
  163. #    $_ = <FILE>;
  164. #    if (!/^\./ || /^\.ps/) {
  165. #      $Groff{'pic'}++;
  166. #      $Groff{'soelim'}++ if $level;
  167. #    }
  168. #      }
  169.     } elsif (/^\.PS[\s\n<]/) {
  170.       $Groff{'pic'}++;
  171.       $Groff{'soelim'}++ if $level;
  172.       if (/^\.PS\s*<\s*(\S+)/) {
  173.     &process($1, $level);
  174.       }
  175.     } elsif (/^\.R1$Sp/) {
  176.       $Groff{'refer'}++;
  177.       $Groff{'soelim'}++ if $level;
  178.     } elsif (/^\.\[/) {
  179.       $Groff{'refer_open'}++;
  180.       $Groff{'soelim'}++ if $level;
  181.     } elsif (/^\.\]/) {
  182.       $Groff{'refer_close'}++;
  183.       $Groff{'soelim'}++ if $level;
  184.     } elsif (/^\.NH$Sp/) {
  185.       $Groff{'NH'}++;        # for ms
  186.     } elsif (/^\.TL$Sp/) {
  187.       $Groff{'TL'}++;        # for mm and ms
  188.     } elsif (/^\.PP$Sp/) {
  189.       $Groff{'PP'}++;        # for mom and ms
  190.     } elsif (/^\.[IL]P$Sp/) {
  191.       $Groff{'ILP'}++;        # for man and ms
  192.     } elsif (/^\.P$/) {
  193.       $Groff{'P'}++;
  194.     } elsif (/^\.(PH|SA)$Sp/) {
  195.       $Groff{'mm'}++;
  196.     } elsif (/^\.TH$Sp/) {
  197.       $Groff{'TH'}++;
  198.     } elsif (/^\.SH$Sp/) {
  199.       $Groff{'SH'}++;
  200.     } elsif (/^\.([pnil]p|sh)$Sp/) {
  201.       $Groff{'me'}++;
  202.     } elsif (/^\.Dd$Sp/) {
  203.       $Groff{'mdoc'}++;
  204.     } elsif (/^\.(Tp|Dp|De|Cx|Cl)$Sp/) {
  205.       $Groff{'mdoc_old'} = 1;
  206.     }
  207.     # In the old version of -mdoc `Oo' is a toggle, in the new it's
  208.     # closed by `Oc'.
  209.     elsif (/^\.Oo$Sp/) {
  210.       $Groff{'Oo'}++;
  211.       s/^\.Oo/\. /;
  212.       redo;
  213.     }
  214.     # The test for `Oo' and `Oc' not starting a line (as allowed by the
  215.     # new implementation of -mdoc) is not complete; it assumes that
  216.     # macro arguments are well behaved, i.e., "" is used within "..." to
  217.     # indicate a doublequote as a string element, and weird features
  218.     # like `.foo a"b' are not used.
  219.     elsif (/^\..* Oo( |$)/) {
  220.       s/\\\".*//;
  221.       s/\"[^\"]*\"//g;
  222.       s/\".*//;
  223.       if (s/ Oo( |$)/ /) {
  224.     $Groff{'Oo'}++;
  225.       }
  226.       redo;
  227.     } elsif (/^\.Oc$Sp/) {
  228.       $Groff{'Oo'}--;
  229.       s/^\.Oc/\. /;
  230.       redo;
  231.     } elsif (/^\..* Oc( |$)/) {
  232.       s/\\\".*//;
  233.       s/\"[^\"]*\"//g;
  234.       s/\".*//;
  235.       if (s/ Oc( |$)/ /) {
  236.     $Groff{'Oo'}--;
  237.       }
  238.       redo;
  239.     } elsif (/^\.(PRINTSTYLE|START)$Sp/) {
  240.       $Groff{'mom'}++;
  241.     }
  242.     if (/^\.so$Sp/) {
  243.       chop;
  244.       s/^.so *//;
  245.       s/\\\".*//;
  246.       s/ .*$//;
  247.       &process($_, $level + 1) unless /\\/ || $_ eq "";
  248.     }
  249.   }
  250.   close(FILE);
  251. }
  252.  
  253. sub help {
  254.   print <<EOF;
  255. usage: grog [option]... [--] [filespec]...
  256.  
  257. "filespec" is either the name of an existing, readable file or "-" for
  258. standard input.  If no "filespec" is specified, standard input is
  259. assumed automatically.
  260.  
  261. "option" is either a "groff" option or one of these:
  262.  
  263. -C            compatibility mode
  264. -h --help     print this uasge message
  265. -v --version  print version information
  266.  
  267. "groff" options are appended to the output, "-m" options are checked.
  268.  
  269. EOF
  270.   exit 0;
  271. }
  272.  
  273. sub version {
  274.   my ($exit_status) = @_;
  275.   print "Perl version of GNU $Prog of $Last_Update " .
  276.     "in groff version 1.20.1\n";
  277.   exit $exit_status;
  278. }
  279.  
  280. {
  281.   my @m = ();
  282.   my $is_man = 0;
  283.   my $is_mm = 0;
  284.   my $is_mom = 0;
  285.  
  286.   $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
  287.  
  288.   if ( $Groff{'pic'} || $Groff{'tbl'} || $Groff{'eqn'} ||
  289.        $Groff{'grn'} || $Groff{'grap'} || $Groff{'refer'} ) {
  290.     my $s = "-";
  291.     $s .= "s" if $Groff{'soelim'};
  292.     $s .= "R" if $Groff{'refer'};
  293.     # grap must be run before pic
  294.     $s .= "G" if $Groff{'grap'};
  295.     $s .= "p" if $Groff{'pic'};
  296.     $s .= "g" if $Groff{'grn'};
  297.     $s .= "t" if $Groff{'tbl'};
  298.     $s .= "e" if $Groff{'eqn'};
  299.     push(@Command, $s);
  300.   }
  301.  
  302.   if ( $Groff{'me'} ) {
  303.     push(@m, '-me');
  304.     push(@Command, '-me');
  305.   }
  306.   if ( $Groff{'SH'} && $Groff{'TH'} ) {
  307.     push(@m, '-man');
  308.     push(@Command, '-man');
  309.     $is_man = 1;
  310.   }
  311.   if ( $Groff{'mom'} ) {
  312.     push(@m, '-mom');
  313.     push(@Command, '-mom');
  314.     $is_mom = 1;
  315.   }
  316.   if ( $Groff{'mm'} || ($Groff{'P'} && ! $is_man) ) {
  317.     push(@m, '-mm');
  318.     push(@Command, '-mm');
  319.     $is_mm = 1;
  320.   }
  321.   if ( $Groff{'NH'} || ($Groff{'TL'} && ! $is_mm) ||
  322.        ($Groff{'ILP'} && ! $is_man) ||
  323.        ($Groff{'PP'} && ! $is_mom && ! $is_man) ) {
  324.     # .PP occurs in -mom, -man and -ms, .IP and .LP occur in -man and -ms
  325.     push(@m, '-ms');
  326.     push(@Command, '-ms');
  327.   }
  328.   if ( $Groff{'mdoc'} ) {
  329.     my $s = ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) ? '-mdoc-old' : '-mdoc';
  330.     push(@m, $s);
  331.     push(@Command, $s);
  332.   }
  333.  
  334.   if ($Groff{'chem'}) {
  335.     my @chem = ('chem', @ARGV, '|', 'groff');
  336.     unshift(@Command, @chem);
  337.   } else {
  338.     unshift @Command, 'groff';
  339.     push(@Command, @ARGV);
  340.   }
  341.  
  342.   foreach (@Command) {
  343.     next unless /\s/;
  344.     $_ = "'" . $_ . "'";
  345.   }
  346.  
  347.   # We could implement an option to execute the command here.
  348.  
  349. #  foreach (@Command) {
  350. #    next unless /[\$\\\"\';&()|<> \t\n]/;
  351. #    s/\'/\'\\\'\'/;
  352. #    $_ = "'" . $_ . "'";
  353. #  }
  354.  
  355.   my $n = scalar @m;
  356.   my $np = scalar @Mparams;
  357.   print STDERR "$Prog: more than 1 `-m' argument: @Mparams" if $np > 1;
  358.   if ($n == 0) {
  359.     unshift @Command, $Mparams[0] if $np == 1;
  360.   } elsif ($n == 1) {
  361.     if ($np == 1) {
  362.       print STDERR "$Prog: wrong `-m' argument: $Mparams[0]\n"
  363.     if $m[0] ne $Mparams[0];
  364.     }
  365.   } else {
  366.     print STDERR "$Prog: error: there are several macro packages: @m\n";
  367.   }
  368.  
  369.   print "@Command\n";
  370.  
  371.   exit $n if $n > 1;
  372.   exit 0;
  373. }
  374.  
  375. ########################################################################
  376. ### Emacs settings
  377. # Local Variables:
  378. # mode: CPerl
  379. # End:
  380.